home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / fieldent.zip / FIELDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  5KB  |  145 lines
  1. {$V-}
  2. Program Fieldemo;
  3.  
  4. (*    05/02/1988     J Tal
  5.                      Rollins Medical/Dental Systems
  6.         
  7.                      Public Domain
  8. *)
  9.  
  10. Uses
  11.   Crt,Funcs,DosBios,Fields;
  12.  
  13.  
  14. VAR
  15.   vMode,
  16.   scr_type: Integer;
  17.      colf : IntAry25;
  18.      cols : StrAry25;
  19.    Intens : StrAry4;
  20.    Ed_cur_str,
  21.    Ed_nor_str,
  22.    Ed_err_str,
  23.    Ed_scr_str : st255;
  24.  
  25.    scrd,
  26.    scrf: StrAry4;
  27.  
  28.    slim,
  29.    flen,
  30.    ii,iii,
  31.    cursor_field : Integer;
  32.    yn_str,
  33.    buff_str: st255;
  34.    i,w,x,y,text_color,text_bak: Integer;
  35.    disp_color: Byte;
  36.    cmnd_str: st255;
  37.  
  38.  
  39. Procedure InitFields;
  40.  
  41. (*    Sample col variable initialization *)
  42. BEGIN
  43.  
  44.     Case Scr_Type OF
  45.        MonoChrome: begin
  46.                   colf[fore,0] := 7;  colf[back,0] := 0;     (*  Main Text foreground background     *)
  47.                   colf[fore,1] := 1;  colf[back,1] := 0;     (*  Editable field passive colors     *)
  48.                   colf[fore,2] := 0;  colf[back,2] := 7;     (*  Editable field active colors     *)
  49.                   colf[fore,3] := 0;  colf[back,3] := 7;     (*  Editable field in error (reversed)     *)
  50.                      colf[fore,4] := 0;  colf[back,4] := 7;     (*  Main Text in reverse         *)
  51.                     end;
  52.        BlackWhite: begin
  53.                   colf[fore,0] := 7;   colf[back,0] := 0;
  54.                   colf[fore,1] := 14;  colf[back,1] := 2;
  55.                   colf[fore,2] := 0;   colf[back,2] := 7;
  56.                   colf[fore,3] := 14;  colf[back,3] := 7;
  57.                      colf[fore,4] := 0;   colf[back,4] := 7;
  58.                     end;
  59.             Color: begin
  60.                   colf[fore,0] := 7;   colf[back,0] := 0;
  61.                   colf[fore,1] := 0;   colf[back,1] := 3;
  62.                   colf[fore,2] := 1;   colf[back,2] := 7;
  63.                   colf[fore,3] := 7;   colf[back,3] := 4;
  64.                      colf[fore,4] := 7;   colf[back,4] := 1;
  65.               end;
  66.        else
  67.        end;
  68.  
  69.  
  70. END;
  71.  
  72. BEGIN
  73.   vMode := Get_Vmode;
  74.   IF vMode = 7 THEN
  75.      scr_type := MonoChrome
  76.   ELSE begin
  77.      Write('Is you monitor able to display more than 2 colors? (y/n)');
  78.      ReadLn(yn_str);
  79.      IF Upcase(yn_str[1]) = 'Y' THEN
  80.         scr_type := Color
  81.      ELSE
  82.         scr_type := BlackWhite;
  83.  
  84.   END;
  85.  
  86.   InitFields;
  87.   ClrScr;
  88.  
  89.   Gotoxy(1,20); Writeln('<Tab> = next field  <Sh-Tab> = prev field  <Esc> = erase to end   <Ret> = end');
  90.  
  91.   (* assign colf colors to Ed_xxx_str's *)
  92.   SetIoCol(scr_type,colf,cols,Intens,Ed_cur_Str,Ed_nor_str,Ed_err_str,Ed_scr_str);
  93.  
  94.   (* initialize input fields and draw field labels *)
  95.   GotoXY(21,8); WriteLn('Field 1');  scrf[1] := '08,30,C 50,' + Ed_nor_str;
  96.   GotoXY(21,10); WriteLn('Field 2');  scrf[2] := '10,30,C 10,' + Ed_nor_str;
  97.   GotoXY(21,12); WriteLn('Field 3');  scrf[3] := '12,30,C 20,' + Ed_nor_str;
  98.   GotoXY(21,14); WriteLn('Field 4');  scrf[4] := '14,30,C 02,' + Ed_nor_str;
  99.   slim := 4;
  100.  
  101.   (* blank out fields, could be existing data from file *)
  102.   FOR i := 1 TO slim DO begin
  103.       w := fnval(Copy(scrf[i],9,2));
  104.       scrd[i] := spaces(w);
  105.   END;
  106.  
  107.   (* output fields *)
  108.   FOR i := 1 TO slim DO begin
  109.      field_out(scr_type,colf[fore,0],colf[back,0],scrf[i],scrd[i]);
  110.  
  111.   (*  optional long-hand way to display data fields
  112.       x := fnval(Copy(scrf[i],4,2));
  113.       y := fnval(Copy(scrf[i],1,2));
  114.       FigScreenAttrib(scr_type,Copy(scrf[i],12,2),Copy(scrf[i],15,2),text_color,text_bak,disp_color);
  115.       Textcolor(text_color);
  116.       Textbackground(text_bak);
  117.       GotoXY(x,y);
  118.       WriteLn(scrd[i]);
  119.   *)
  120.  
  121.   END;
  122.   TextColor(colf[fore,0]);
  123.   TextBackground(colf[back,0]);
  124.  
  125.   cursor_field := 1;
  126.  
  127.   ii := cursor_field;
  128.  
  129.   (* interactive editing begins, ii is control variable *)
  130.   WHILE ii > -2 DO begin   (* while return not pressed *)
  131.      cmnd_str := copy(scrf[ii],1,11) + Ed_cur_str;  (* current field *)
  132.      iii := ii;                        (* remember ii in iii cause ii changes *)
  133.      buff_str := scrd[iii];                         (* starting input is field's current contents *)
  134.      field_in(scr_type,colf[fore,0],colf[back,0],cmnd_str,buff_str,flen,ii);  (* field editing *)
  135.      scrd[iii] := buff_str;                         (* edited *)
  136.      cmnd_str := copy(scrf[iii],1,11) + Ed_nor_str; (* restore field to orig state *)
  137.      field_out(scr_type,colf[fore,0],colf[back,0],cmnd_str,buff_str);
  138.      if ii > slim then ii := 1;                     (* tab goes to next field, if at end wrap to top *)
  139.      if ii = 0 then ii := slim;                     (* shift-tab goes to prev field, if at top wrap to bottom *)
  140.   END;
  141.  
  142.  
  143.  
  144. END.
  145.